home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Languages Suite
/
ProgramD2.iso
/
Visual Database
/
Visual dBase v5.5
/
SAMPLES1.PAK
/
ORDERS.WFM
< prev
next >
Wrap
Text File
|
1995-07-18
|
27KB
|
870 lines
*******************************************************************************
* PROGRAM: Orders.wfm
*
* WRITTEN BY: Borland Samples Group
*
* DATE: 1/94
*
* UPDATED: 5/95
*
* REVISION: $Revision: 1.97 $
*
* VERSION: Visual dBASE
*
* DESCRIPTION: This form displays information about an order from a company.
* It allows traversing through orders and going to the top and
* bottom. This form also has a corresponding menu, OrdCust.mnu,
* which allows adding,deleting and searching for an order.
* When an unknown customer number is entered, a dialog will come
* up asking you if you want to add a new customer. If you
* selecte the Yes button, the Customer form (in customer.wfm)
* will be opened, so a new customer can be added.
*
* PARAMETERS: None
*
* CALLS: Orders.mnu (Menu file)
* Buttons.cc (Custom controls file)
* Customer.wfm (Form for displaying customer information)
* Orders.qbe (View of tables)
*
* USAGE: DO Orders.wfm && Note that you can also DO Customer.wfm
*
*******************************************************************************
#include <Messdlg.h>
shell(.F., .T.)
create session
set talk off
set ldCheck off && To avoid language driver conflicts
** END HEADER -- do not remove this line*
* Generated on 07/11/95
*
parameter bModal
local f
f = new ORDERSFORM()
if (bModal)
f.mdi = .F. && ensure not MDI
f.ReadModal()
else
f.Open()
endif
CLASS ORDERSFORM OF FORM
Set Procedure To &_dbwinhome.samples\BUTTONS.CC additive
this.Width = 92.666
this.MenuFile = "ORDERS.MNU"
this.View = "ORDERS.QBE"
this.OnClose = CLASS::ONCLOSE
this.EscExit = .F.
this.Top = 0
this.MousePointer = 1
this.Left = 3.333
this.ColorNormal = "BtnText/BtnFace"
this.Text = "Orders -- View Mode"
this.Height = 20.8232
this.Maximize = .F.
this.Minimize = .F.
DEFINE RECTANGLE ORDERCUSTRECT OF THIS;
PROPERTY;
Width 75.6504,;
Top 0.3486,;
Left 0.8486,;
ColorNormal "BtnFace",;
Text "Order Info",;
Height 2.7686
DEFINE RECTANGLE PAYMENTRECT OF THIS;
PROPERTY;
Width 33.9834,;
Top 10.5684,;
Left 0.8486,;
ColorNormal "BtnFace",;
Text "Totals",;
Height 6.0781
DEFINE RECTANGLE SHIPRECT OF THIS;
PROPERTY;
Width 75.6504,;
Top 16.8184,;
Left 0.8486,;
ColorNormal "BtnFace",;
Text "Ship Info",;
Height 3.416
DEFINE TEXT ORDERNOTEXT OF THIS;
PROPERTY;
Width 10.9512,;
Top 1.2393,;
Left 2.5488,;
ColorNormal "B/BtnFace",;
Text "Order No:",;
Height 1.2305,;
Alignment 5
DEFINE ENTRYFIELD ORDERNOENTRY OF THIS;
PROPERTY;
Width 6.8838,;
Top 1.1895,;
Left 14.4482,;
ColorNormal "N/BtnFace",;
Height 1.1631,;
Enabled .F.,;
DataLink "ORDERS->ORDER_NO",;
OnChange CLASS::CHANGESMADE
DEFINE TEXT CUSTOMERNOTEXT OF THIS;
PROPERTY;
Width 13.165,;
Top 1.2393,;
Left 25.5,;
ColorNormal "B/BtnFace",;
Text "Customer No:",;
Height 1.2305,;
Alignment 5
DEFINE ENTRYFIELD CUSTOMERNOENTRY OF THIS;
PROPERTY;
Width 6.0654,;
Top 1.1895,;
Left 39.0986,;
ColorNormal "N/BtnFace",;
Height 1.1631,;
Enabled .F.,;
DataLink "ORDERS->CUSTOMER_N",;
OnChange CLASS::CHANGESMADE
DEFINE TEXT SALEDATETEXT OF THIS;
PROPERTY;
Width 12.915,;
Top 1.2393,;
Left 46.75,;
ColorNormal "B/BtnFace",;
Text "&Sale Date:",;
Height 1.2305,;
Alignment 5
DEFINE SPINBOX SALEDATESPIN OF THIS;
PROPERTY;
ColorHighlight "B+/W*",;
Rangemax 100,;
Width 13.6338,;
Rangemin 0,;
Top 1.1895,;
Left 61.1982,;
ColorNormal "N/BtnFace",;
Height 1.1631,;
Enabled .F.,;
DataLink "ORDERS->SALE_DATE",;
OnChange CLASS::CHANGESMADE
DEFINE RECTANGLE LINEITEMSRECT OF THIS;
PROPERTY;
Width 75.6504,;
Top 3.3799,;
Left 0.8486,;
ColorNormal "BtnFace",;
Text "&Line Items",;
Height 7.0313
DEFINE BROWSE CHILDBROWSE OF THIS;
PROPERTY;
Width 73.9668,;
Fields "STOCK_NO\13,QTY\14,SELL_PRICE\16,TOTAL = SELL_PRICE*QTY\16",;
Top 4.4697,;
Left 1.6982,;
CUATab .T.,;
ColorNormal "BtnText/BtnFace",;
ColorHighlight "B+/W*",;
Height 5.4121,;
Modify .F.,;
OnNavigate CLASS::BROWSEONNAVIGATE,;
ShowRecNo .F.,;
Alias "Lineitem",;
OnChange CLASS::BROWSECHANGESMADE,;
ShowDeleted .F.,;
Delete .F.,;
Append .F.
DEFINE TEXT TOTINVTEXT OF THIS;
PROPERTY;
Width 13.6338,;
Top 11.6182,;
Left 1.6982,;
ColorNormal "B/BtnFace",;
Text "Total Invoice:",;
Height 1.0869,;
Alignment 8
DEFINE ENTRYFIELD TOTINVENTRY OF THIS;
PROPERTY;
Width 17,;
Top 11.6182,;
Left 17,;
ColorHighlight "B+/W*",;
ColorNormal "N/BtnFace",;
Function "J",;
Height 1.0283,;
Enabled .F.,;
DataLink "ORDERS->TOTAL",;
Picture "9,999,999.99"
DEFINE TEXT TOTPAIDTEXT OF THIS;
PROPERTY;
Width 13.1338,;
Top 13.1299,;
Left 1.6982,;
ColorNormal "B/BtnFace",;
Text "A&mount Paid:",;
Height 0.9873,;
Alignment 8
DEFINE ENTRYFIELD AMTPAIDENTRY OF THIS;
PROPERTY;
Width 17,;
Top 13.1299,;
Left 17,;
ColorHighlight "B+/W*",;
ColorNormal "N/BtnFace",;
Function "J",;
Height 0.9873,;
Enabled .F.,;
DataLink "ORDERS->AMT_PAID",;
OnChange CLASS::AMTPAIDONCHANGE,;
Picture "9,999,999.99"
DEFINE TEXT BALDUETEXT OF THIS;
PROPERTY;
Width 13.1338,;
Top 14.6484,;
Left 1.6982,;
ColorNormal "B/BtnFace",;
Text "Balance Due:",;
Height 0.998,;
Alignment 8
DEFINE ENTRYFIELD BALDUEENTRY OF THIS;
PROPERTY;
Width 17,;
Top 14.6484,;
Left 17,;
ColorHighlight "B+/W*",;
ColorNormal "N/BtnFace",;
Function "J",;
Height 0.998,;
Enabled .F.,;
Value 0,;
Picture "9,999,999.99"
DEFINE RECTANGLE TERMSRECT OF THIS;
PROPERTY;
Width 16.1338,;
Top 10.5684,;
Left 35.6982,;
ColorNormal "BtnFace",;
Text "&Terms",;
Height 6.0781
DEFINE RADIOBUTTON TERMSFOB OF THIS;
PROPERTY;
Width 12.7656,;
Group .T.,;
Top 11.2295,;
Left 37.3984,;
ColorNormal "N/BtnFace",;
Text "FOB",;
Height 1.2402,;
Enabled .F.,;
DataLink "TERMS",;
OnChange CLASS::CHANGESMADE
DEFINE RADIOBUTTON TERMSNET30 OF THIS;
PROPERTY;
Width 12.7656,;
Group .F.,;
Top 12.2988,;
Left 37.3984,;
ColorNormal "N/BtnFace",;
Text "Net 30",;
Height 1.2305,;
Enabled .F.,;
DataLink "TERMS",;
OnChange CLASS::CHANGESMADE
DEFINE RECTANGLE PAYMETHODRECT OF THIS;
PROPERTY;
Width 23.8008,;
Top 10.6094,;
Left 52.6982,;
ColorNormal "BtnFace",;
Text "Pa&yment Method",;
Height 6.0371
DEFINE RADIOBUTTON PAYCHECK OF THIS;
PROPERTY;
Width 12.7656,;
Group .T.,;
Top 11.3984,;
Left 54.3984,;
ColorNormal "N/BtnFace",;
Text "Check",;
Height 1.0127,;
Enabled .F.,;
DataLink "PAY_METHOD",;
OnChange CLASS::CHANGESMADE,;
ID 1
DEFINE RADIOBUTTON PAYCREDIT OF THIS;
PROPERTY;
Width 12.7656,;
Group .F.,;
Top 12.4688,;
Left 54.3984,;
ColorNormal "N/BtnFace",;
Text "Credit",;
Height 0.6484,;
Enabled .F.,;
DataLink "PAY_METHOD",;
OnChange CLASS::CHANGESMADE,;
ID 1
DEFINE RADIOBUTTON PAYMC OF THIS;
PROPERTY;
Width 12.7656,;
Group .F.,;
Top 13.3594,;
Left 54.3984,;
ColorNormal "N/BtnFace",;
Text "MC",;
Height 0.7578,;
Enabled .F.,;
DataLink "PAY_METHOD",;
OnChange CLASS::CHANGESMADE
DEFINE RADIOBUTTON PAYCASH OF THIS;
PROPERTY;
Width 12.7656,;
Group .F.,;
Top 14.3184,;
Left 54.3984,;
ColorNormal "N/BtnFace",;
Text "Cash",;
Height 0.9756,;
Enabled .F.,;
DataLink "PAY_METHOD",;
OnChange CLASS::CHANGESMADE
DEFINE RADIOBUTTON PAYVISA OF THIS;
PROPERTY;
Width 10.9346,;
Group .F.,;
Top 15.3281,;
Left 54.3984,;
ColorNormal "N/BtnFace",;
Text "Visa",;
Height 1.0244,;
Enabled .F.,;
DataLink "PAY_METHOD",;
OnChange CLASS::CHANGESMADE
DEFINE TEXT SHIPDATETEXT OF THIS;
PROPERTY;
Width 12.7969,;
Top 17.7686,;
Left 1.8682,;
ColorNormal "B/BtnFace",;
Text "S&hip Date:",;
Height 0.7012,;
Alignment 5
DEFINE SPINBOX SHIPDATESPIN OF THIS;
PROPERTY;
Rangemax 100,;
Width 17.332,;
Rangemin 0,;
Top 17.3486,;
Left 17,;
ColorHighlight "B+/W*",;
ColorNormal "N/BtnFace",;
Height 1.1807,;
Enabled .F.,;
DataLink "ORDERS->SHIP_DATE",;
OnChange CLASS::CHANGESMADE
DEFINE TEXT SHIPVIATEXT OF THIS;
PROPERTY;
Width 11.2676,;
Top 18.8389,;
Left 3.3984,;
ColorNormal "B/BtnFace",;
Text "Ship &Via:",;
Height 1.2197,;
Alignment 5
DEFINE RADIOBUTTON SHIPDHL OF THIS;
PROPERTY;
Width 10.1504,;
Group .T.,;
Top 19.1895,;
Left 17.8486,;
ColorNormal "N/BtnFace",;
Text "DHL",;
Height 0.8105,;
Enabled .F.,;
DataLink "SHIP_VIA",;
OnChange CLASS::CHANGESMADE
DEFINE RADIOBUTTON SHIPEMERY OF THIS;
PROPERTY;
Width 10.1016,;
Group .F.,;
Top 19.1895,;
Left 28.8984,;
ColorNormal "N/BtnFace",;
Text "Emery",;
Height 0.8105,;
Enabled .F.,;
DataLink "SHIP_VIA",;
OnChange CLASS::CHANGESMADE
DEFINE RADIOBUTTON SHIPFEDEX OF THIS;
PROPERTY;
Width 10.2334,;
Group .F.,;
Top 19.1895,;
Left 39.0986,;
ColorNormal "N/BtnFace",;
Text "FedEx",;
Height 0.8105,;
Enabled .F.,;
DataLink "SHIP_VIA",;
OnChange CLASS::CHANGESMADE
DEFINE RADIOBUTTON SHIPUPS OF THIS;
PROPERTY;
Width 10.1836,;
Group .F.,;
Top 19.1895,;
Left 50.1484,;
ColorNormal "N/BtnFace",;
Text "UPS",;
Height 0.8105,;
Enabled .F.,;
DataLink "SHIP_VIA",;
OnChange CLASS::CHANGESMADE
DEFINE RADIOBUTTON SHIPUSMAIL OF THIS;
PROPERTY;
Width 12.8008,;
Group .F.,;
Top 19.1895,;
Left 61.1982,;
ColorNormal "N/BtnFace",;
Text "US Mail",;
Height 0.8105,;
Enabled .F.,;
DataLink "SHIP_VIA",;
OnChange CLASS::CHANGESMADE
DEFINE PREVBUTTON PREVORDERBUTTON OF THIS;
PROPERTY;
Width 14.1504,;
Group .T.,;
Top 0.7988,;
Left 77.3486,;
Height 1.5537,;
OnClick CLASS::PREVIOUS
DEFINE NEXTBUTTON NEXTORDERBUTTON OF THIS;
PROPERTY;
Width 14.1504,;
Group .F.,;
Top 3.1484,;
Left 77.3486,;
Height 1.5566,;
OnClick CLASS::NEXT,;
Default .T.
DEFINE PUSHBUTTON FIRSTORDERBUTTON OF THIS;
PROPERTY;
Width 14.1504,;
Group .F.,;
Top 5.2295,;
Left 77.3486,;
ColorNormal "",;
Text "F&irst",;
Height 1.5352,;
OnClick {;form.CheckCommit(form.inEditMode);go top}
DEFINE PUSHBUTTON LASTORDERBUTTON OF THIS;
PROPERTY;
Width 14.1504,;
Group .F.,;
Top 7.4189,;
Left 77.3486,;
ColorNormal "",;
Text "L&ast",;
Height 1.5215,;
OnClick {;form.CheckCommit(form.inEditMode);go bottom}
DEFINE IMAGE LOGOIMAGE OF THIS;
PROPERTY;
Width 15.3154,;
Top 17.3486,;
Left 77.3486,;
Height 2.8271,;
DataSource "FILENAME DIVESHOP.BMP",;
Alignment 1
DEFINE SAMPLEINFOBUTTON ORDERSINFOBUTTON OF THIS;
PROPERTY;
Width 3.5654,;
Group .T.,;
Top 9.5,;
Left 87.5986,;
Height 1.2051
procedure Open
****************************************************************************
private orderNoField
if type("form.init") = "U"
form.init = .T.
set skip to && orders.qbe contains set skip to lineitem
set exact off && the .qbe file contains SET EXACT ON
set procedure to &_dbwinhome.samples\Sampproc.prg additive
form.inEditMode = .F. && indicator of view/edit state
form.changesMade = .F. && indicator of changes made to field values
form.previousRecord = .F. && Save record number when appending
*** do calculations in another area so form doesn't get updated
use orders again in select() alias temp
select temp
orderNoField = field(1) && order_no field
set order to &orderNoField && order_no -- tag name is same as field
go bottom
form.maxOrder = &orderNoField && max value for key field -- for creating
&& new orders
use in temp
select orders
***
*** Open table for calculating totals and balance due in another work area
*** so that datalinks are not affected by record movements
use lineitem again in select() alias lineitem2 order tag order_no
select orders
set relation to order_no into lineitem2 constrain integrity additive
***
if type("form.parentCustomerForm") <> "U" && Esc ok if have parent
form.escExit = .T.
endif
endif
form.ordersInfoButton.sampleName = "Orders.wfm"
form.BrowseOnNavigate() && calculate totals
form::Open() && Now the form actually opens
****************************************************************************
procedure OnClose
****************************************************************************
if form.inEditMode
form.ViewEdit()
endif
&& Close Customer form if it exists
if .not. type ("form.childCustomerForm") $ "U,L"
form.childCustomerForm.Release()
close procedure &_dbwinhome.samples\Customer.wfm
endif
if type("form.parentCustomerForm") = "U" && If called from Customer,
&& leave shell(.F.)
shell(.T.)
endif
close procedure &_dbwinhome.samples\SampProc.prg,;
&_dbwinhome.samples\Buttons.cc
****************************************************************************
procedure BrowseOnNavigate
* calculate total invoice and balance
****************************************************************************
if eof()
form.root.order.viewEdit.enabled = .F.
else
form.root.order.viewEdit.enabled = .T.
form.balDueEntry.value = orders->total - form.AmtPaidEntry.value
show object form.balDueEntry
endif
form.CallShowCustomer()
****************************************************************************
procedure ChangesMade
* Indicate that changes have been made to current record.
****************************************************************************
form.changesMade = .T.
****************************************************************************
procedure BrowseChangesMade
****************************************************************************
local t
form.changesMade = .T.
go recno("LINEITEM") in lineitem && Make sure change is posted
select lineitem2 && recalculate totals in other workarea
calculate sum(lineitem2->sell_price * lineitem2->qty) to t
select orders
replace orders->total with t
form.balDueEntry.value = orders->total - orders->amt_paid
****************************************************************************
procedure AmtPaidOnChange
****************************************************************************
form.changesMade = .T.
form.BrowseOnNavigate() && calculate totals
****************************************************************************
procedure Next
****************************************************************************
form.CheckCommit(form.inEditMode)
if .not. eof()
NEXTBUTTON::OnClick()
endif
****************************************************************************
procedure Previous
****************************************************************************
form.CheckCommit(form.inEditMode)
PREVBUTTON::OnClick()
****************************************************************************
procedure CheckCommit (newInEditMode)
* Finish transaction, if it has been started.
****************************************************************************
private orderField, changesMade
changesMade = form.changesMade
if form.changesMade
orderField = field(1) && Field Order_no
if ConfirmationMessage("Commit changes?",;
FormatStr("Order %1",&orderField)) = YES
commit()
else
rollback()
if .not. empty(form.previousRecord)
go form.previousRecord
form.previousRecord = .F.
endif
endif
if form.inEditMode .and. newInEditMode
begintrans()
endif
form.changesMade = .F.
endif
if form.inEditMode <> newInEditMode
if newInEditMode && Going to Edit mode
begintrans()
else && Going to View mode
if .not. changesMade
rollback()
endif
endif
form.inEditMode = newInEditMode
endif
****************************************************************************
procedure ViewEdit
****************************************************************************
local inEditMode, control, editMenu
editMenu = form.root.order.viewEdit
*** If editing is completed, close transaction, otherwise open a transaction
if form.inEditMode && Change to View mode
form.checkChanged(.F.)
editMenu.text = "&Edit"
editMenu.shortcut = "Ctrl-E"
editMenu.statusMessage = "Edit data."
form.root.order.delete.enabled = .F. && disabled in view mode
form.CheckCommit(.F.) && Check transaction and
form.text = "Orders -- View Mode" && change mode to View
form.childBrowse.modify = .F.
form.statusMessage = "Select Order - Edit menu choice to " +;
"edit/delete data."
else && Change to Edit mode
editMenu.text = "&View"
editMenu.shortcut = "Ctrl-E"
editMenu.statusMessage = "View data."
form.root.order.delete.enabled = .T. && enabled in edit mode
form.CheckCommit(.T.) && Check transaction and
form.text = "Orders -- Edit Mode" && change mode to Edit
form.childBrowse.modify = .T.
form.statusMessage = "In Edit Mode. " +;
"Select Order - View menu choice to switch " +;
"to View mode."
endif
form.childBrowse.setFocus()
control = form.first
inEditMode = form.inEditMode && so don't have to reference many times
do
do case
case control.name $ "ORDERNOENTRY,CUSTOMERNOENTRY,TOTINVENTRY,BALDUEENTRY"
* these are never editable
control.enabled = .F.
case .not. control.className $ "BROWSE,NEXTBUTTON,PREVBUTTON,PUSHBUTTON,IMAGE,TEXT"
* doesn't make sense to make the above classes enabled/not
control.enabled = inEditMode
case control.className = "BROWSE"
control.Modify = inEditMode
control.Delete = inEditMode
control.Append = inEditMode
endcase
control = control.before
until control.name = form.first.name
form.CustomerNoEntry.enabled = .F. && Key field is always disabled
form.OrderNoEntry.enabled = .F. && Key field is always disabled
form.setFocus()
****************************************************************************
procedure CheckChanged(callCommit)
* Check if changes have been made to the current entryfield. This procedure
* is called from menu routines to make sure the form.changesMade gets
* updated when a menu is selected while the changed control has focus.
****************************************************************************
private control, fieldValue, controlValue, typeText, typeValue
if form.inEditMode
control = form.activeControl
if type("control.datalink") <> "U"
fieldValue = control.datalink && name of table field
typeText = type("control.text")
typeValue = type("control.value")
do case
case typeValue = "C"
controlValue = control.value
case typeValue $ "LU" .and. typeText = "C"
controlValue = control.text
otherwise
controlValue = Null
endcase
if controlValue <> &fieldValue
form.changesMade = .T.
endif
endif
endif
if form.changesMade .and. callCommit
CLASS::CheckCommit(form.inEditMode) && Check transactions
endif
****************************************************************************
procedure StartCustomerForm
* Starts the Customer form in it's own session. Note that control returns
* to the current session when this procedure is returned from. This means
* that between the create session command and return you cannot access
* tables in the current session.
****************************************************************************
local custNo
custNo = orders->customer_n && Pass customer_n into into
&& customer form in the new session
create session
set talk off && Set these for the new session
set ldCheck off
set procedure to &_dbwinhome.samples\Customer.wfm additive
form.childCustomerForm = new CustomerForm() && Use Customer.wfm to view
&& or edit a customer
form.childCustomerForm.top = 2.02
form.childCustomerForm.left = 4.25
form.childCustomerForm.customer_n = custNo
form.childCustomerForm.parentOrdersForm = form && Store a reference to this
&& form so that Orders can
&& call events in this form
form.childCustomerForm.open()
****************************************************************************
procedure CallShowCustomer
* Synchronizes the Customer form to the same customer. This is done when
* Orders is run first (form.parentCustomerForm is undefined), and the
* Customer form has been opened (form.childCustomerForm is defined).
****************************************************************************
if type("form.parentCustomerForm") = "U" && Orders is the parent form
if type ("form.childCustomerForm") <> "U" && Customer form defined
form.childCustomerForm.ShowCustomer(orders->customer_n)
endif
endif
****************************************************************************
procedure ShowOrders(custNo, orderNo)
* Called by Customer.wfm when it is the first form run. Used to synchronize
* this form to the same customer for a given order displayed in Customer.
****************************************************************************
private pCustNo
form.CheckChanged(.T.)
set order to custord && Order is customer_n + order_no
pCustNo = custNo && Parameters are local so cannot macro
form.customer_n = custNo && For adding new orders
set key to "&pCustNo" && Only see corresponding orders
go top
seek custNo + orderNo
ENDCLASS